module Interface_utlities where

import qualified Data.Map                as M
import qualified Data.Sequence           as Q
import qualified Data.Word               as W
import qualified Data.Graph.Inductive    as G
import Data.Graph.Inductive ((&))
import qualified Text.JSON               as JS

import Graph_utilities

data Reg = Reg{ reg_id :: Int, reg_flags :: W.Word32 }

data Instr = Instr { instr_disas  :: String
                   , instr_opcode :: String
                   , instr_flags  :: W.Word32
                   , instr_reads  :: Q.Seq Reg
                   , instr_writes :: Q.Seq Reg }

bblf_none           =  0x0
bblf_is_call        =  0x1
bblf_is_entry       =  0x2
bblf_is_exit        =  0x4
bblf_is_stat_ret    =  0x8
bblf_is_dyn_ret     = 0x10
bblf_dummy_call_ret = 0x20

-- This version is for when we're just doing one BBL at a time

extract_bbl :: JS.JSObject JS.JSValue -> Dfg
extract_bbl o = dfg_done
    where
      JS.Ok ( JS.JSRational _ bbl_idr )    = JS.valFromObj "id"        o
      JS.Ok ( JS.JSRational _ bbl_flagsr ) = JS.valFromObj "flags"     o
      JS.Ok ( JS.JSArray      inss_json )  = JS.valFromObj "inss"      o
      JS.Ok ( JS.JSArray      lis_json )   = JS.valFromObj "live_ins"  o
      JS.Ok ( JS.JSArray      los_json )   = JS.valFromObj "live_outs" o

      -- Translate a live-in from JSON and add it to the DFG
      -- Also maintain a mapping of register names to nodes
      -- Designed to be folded over a list of JSON live-ins
      add_li :: (Dfg, M.Map String G.Node) -> JS.JSValue -> (Dfg, M.Map String G.Node)
      add_li ( dfg_adding_live_ins, dfg_symb_table_adding_live_ins ) ( JS.JSObject li_json ) =
          (dfg_insert_before form_data queue_back dfg_added,
           M.insert name act dfg_symb_table_adding_live_ins)
          where
            JS.Ok( JS.JSString name_json ) = JS.valFromObj "name" li_json
            name = JS.fromJSString name_json
            [act, form_net, form_data] = G.newNodes 3 dfg_adding_live_ins
            formal_net_ctx =
                ([], form_net, DfgNet Nothing, [(DfgPort (-1),live_in_hub_id)])
            formal_data_ctx =
                ([], form_data, DfgData, [(DfgPort 0,form_net)])
            actual_ctx =
                ([(DfgPort (-1),live_in_hub_id)],act, DfgNet (Just name), [])
            dfg_added = formal_data_ctx & (formal_net_ctx & (actual_ctx & dfg_adding_live_ins))

      ( dfg_just_live_ins, dfg_symb_table_live_ins ) =
          foldl add_li ( dfg_template, M.empty ) lis_json

      -- Translate an intruction from JSON and add it to the DFG
      -- Also maintain a mapping of register names to nodes
      -- Designed to be folded over a list of JSON instructions
      --add_ins :: (Dfg, IM.IntMap G.Node) -> Instr -> (Dfg, IM.IntMap G.Node)
      add_ins ( dfg_adding_ins, dfg_symb_table_adding_ins ) ( JS.JSObject ins_json ) =
          (dfg_add_ins, dfg_symb_table_added_ins)
          where
            JS.Ok ( JS.JSString     opcode_json ) = JS.valFromObj "opc"    ins_json
            JS.Ok ( JS.JSRational _ bbl_flagsr  ) = JS.valFromObj "flags"  ins_json
            JS.Ok ( JS.JSArray      reads_json  ) = JS.valFromObj "reads"  ins_json
            JS.Ok ( JS.JSArray      writes_json ) = JS.valFromObj "writes" ins_json

            -- add_read is written to be used with mapAccumL
            add_read (dfg_adding_reads, port) (JS.JSObject r) =
                ((dfg_added_read, port+1), (DfgPort port,net_for_r))
                where
                  JS.Ok (JS.JSString fname_j) = JS.valFromObj "fn" r
                  rname = JS.fromJSString fname_j
                  net_for_r = case M.lookup rname dfg_symb_table_adding_ins of
                                Just n -> n
                                Nothing -> error ("bad ins "++rname)
                  (is, name, os, dfg') =
                      g_unsafe_match_net "gimme input net" net_for_r dfg_adding_reads
                  dfg_added_read = (is, net_for_r, DfgNet name, os) & dfg'

            ((dfg_all_reads,_), reads) = mapAccumL add_read (dfg_adding_ins,0) reads_json
            [ins_id] = G.newNodes 1 dfg_all_reads
            instr_ctx = (foldl (flip(:)) [] reads,
                         ins_id,
                         DfgOp $ JS.fromJSString opcode_json,
                         [])
            dfg_added_ins = (instr_ctx & dfg_all_reads)

            -- add_write is written to be used with foldl
            add_write (dfg_adding_writes, dfg_symb_table_adding_writes, port) (JS.JSObject w) =
                (dfg_added_write, symb_table_added_write, port+1)
                where
                  JS.Ok (JS.JSString fname_j) = JS.valFromObj "fn" w
                  fname = JS.fromJSString fname_j
                  [write_id] = G.newNodes 1 dfg_adding_writes
                  net_ctx = ([(DfgPort port, ins_id)], write_id, DfgNet (Just fname), [])
                  dfg_added_write = net_ctx & dfg_adding_writes
                  symb_table_added_write = M.insert fname write_id
                                                     dfg_symb_table_adding_writes
            (dfg_add_ins, dfg_symb_table_added_ins, _) =
                foldl add_write (dfg_added_ins, dfg_symb_table_adding_ins, 0) writes_json

      ( dfg_no_live_outs_yet, dfg_symb_table_no_live_outs_yet ) =
          foldl add_ins ( dfg_just_live_ins, dfg_symb_table_live_ins ) inss_json

      -- Translate a live-out from JSON and add it to the DFG
      -- Designed to be folded over a list of JSON live-outs
      add_lo :: Dfg -> JS.JSValue -> Dfg
      add_lo dfg_adding_live_outs ( JS.JSObject lo_json ) =
          --T.trace "add_lo"
          dfg_insert_before lo_data out_queue_back dfg_live_out_added
          where
            JS.Ok( JS.JSString name_json ) = JS.valFromObj "name" lo_json
            rname = JS.fromJSString name_json
            net_for_r = case M.lookup rname dfg_symb_table_no_live_outs_yet of
                          Just n -> n
                          Nothing -> error ("I justadd live out "++rname)
            (is, name, os, dfg') =
                g_unsafe_match_net "gimme input net" net_for_r dfg_adding_live_outs
            [loq_id, lo_data] = G.newNodes 2 dfg_adding_live_outs
            lod_ctx = (is, net_for_r, DfgNet name,
                             (DfgPort (-1),live_out_hub_id):os)
            form_ctx = ([(DfgPort (-1),live_out_hub_id)], loq_id, DfgNet Nothing, [])
            formal_data_ctx =
                ([(DfgPort 0,loq_id)], lo_data, DfgData, [])
            dfg_live_out_added = formal_data_ctx & (form_ctx & (lod_ctx & dfg'))

      dfg_with_live_outs = foldl add_lo dfg_no_live_outs_yet los_json

      fooooob :: Dfg -> G.Node -> Dfg
      fooooob dfg_dropping n = case G.context dfg_dropping n of
        (_, _, _, _:_) -> dfg_dropping
        ([(_,pred)], _, DfgNet net_name, []) | pred /= live_out_hub_id ->
          ([(DfgPort 0, n)], drop, DfgDrop, []) & dfg_dropping
          where
            [drop] = G.newNodes 1 dfg_dropping
        (_, _, _, []) -> dfg_dropping
        
      dfg_done = foldl fooooob dfg_with_live_outs (G.nodes dfg_with_live_outs)
